home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / RubbishDump / RubbishDump.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-11  |  12KB  |  443 lines
  1. Program RubbishDump;
  2. {$F-,I-,R-,S-,V-,M 4,1,1,15}
  3.  
  4. Uses
  5.     Exec, AmigaDos, Icon, Workbench, Intuition, CStrConstPtr, Amiga, 
  6.     TType, MRexx, CX, Rexx, Commodities, AppIcon, DOS;
  7.  
  8. Const
  9.     {Version : string[32] = '$VER: Rubbish_Dump 0.1 19.01.95'#0;}
  10.     {Version : string[32] = '$VER: RubbishDump 1.0 (22.01.95)'#0;}
  11.     {Version : string[33] = '$VER: RubbishDump 1.1 (23.01.95)'#0;}
  12.     Version : string[33] = '$VER: RubbishDump 1.2 (28.04.95)'#0;
  13.     cxname  = 'Rubbish Dump';
  14.     cxtitle = 'Rubbish Dump v1.1 ©95 Lee Kindness.';
  15.     cxdesc  = 'Trash on Workbench... Sound too.';
  16.     
  17. Type
  18.     tProgVars = Record
  19.         arg_LeftEdge,
  20.         arg_TopEdge,
  21.         arg_CXPri : LONG;
  22.         arg_Icon,
  23.         arg_Name,
  24.         arg_RexxPort,
  25.         arg_RexxCmd : String;
  26.     End;
  27.     
  28. (***************************************************************************)
  29. (***************************************************************************)
  30. Procedure GetToolTypes(VAR Args : tProgVars);
  31.  
  32. VAR
  33.     dobj    : pDiskObject;
  34.     Tmpstr  : STRPTR;
  35.     RemKey  : pRemember;
  36.     olddir  : BPTR;
  37.     
  38. CONST
  39.     ArgPtr : ppbyte = NIL;
  40.     ToolRead : Boolean = FALSE;
  41.     OPT_LEFTEDGE   =  1;
  42.     OPT_TOPEDGE    =  2;
  43.     OPT_ICON       =  3;
  44.     OPT_NAME       =  4;
  45.     OPT_REXXPORT   =  5;
  46.     OPT_REXXCMD    =  6;
  47.     OPT_CXPRI      =  7;
  48.     RDA : Array[1..10] of LONG = (0);
  49.     RDArg : pRDArgs = NIL;
  50.     
  51. Begin
  52.     With Args do begin
  53.         arg_LeftEdge     := 0;
  54.         arg_TopEdge      := 0;
  55.         arg_CXPri        := -20;
  56.         arg_Icon         := '';
  57.         arg_Name         := 'Rubbish Dump';
  58.         arg_RexxPort     := 'PLAY';
  59.         arg_RexxCmd      := 'id TRASH';
  60.     End;
  61.     RemKEy := NIL;
  62.     
  63.     If CmdLinePtr.Len >= 1 then begin
  64.         RDArg := ReadArgs(CSCPAR(@RemKey, 
  65.          'X=LEFTEDGE/K/N,Y=TOPEDGE/K/N,I=ICON/K,N=NAME/K,'+
  66.          'RP=REXXPORT/K,RC=REXXCMD/K,CX_PRIORITY/K/N'),@RDA,NIL);
  67.         if RDArg <> NIL then begin
  68.             With Args do begin
  69.                 If RDA[OPT_LEFTEDGE] <> 0 then
  70.                     arg_LeftEdge := pLONG(RDA[OPT_LEFTEDGE])^;
  71.                 If RDA[OPT_TOPEDGE] <> 0 then
  72.                     arg_TopEdge := pLONG(RDA[OPT_TOPEDGE])^;
  73.                 If RDA[OPT_ICON] <> 0 then
  74.                     arg_Icon := PtrToPas(STRPTR(RDA[OPT_ICON]));
  75.                 If RDA[OPT_NAME] <> 0 then
  76.                     arg_Name := PtrToPas(STRPTR(RDA[OPT_NAME]));
  77.                 If RDA[OPT_REXXPORT] <> 0 then
  78.                     arg_RexxPort := PtrToPas(STRPTR(RDA[OPT_REXXPORT]));
  79.                 If RDA[OPT_REXXCMD] <> 0 then
  80.                     arg_RexxCmd := PtrToPAs(STRPTR(RDA[OPT_REXXCMD]));
  81.                 If RDA[OPT_CXPRI] <> 0 then
  82.                     arg_CXPri := pLONG(RDA[OPT_CXPRI])^;
  83.             End;
  84.             FreeArgs(RDArg);
  85.         End;
  86.     end else begin
  87.         dobj := GetDiskObject(STRPTR(pWBStartup(WBenchMsg)^.sm_ArgList^.wa_Name));
  88.         if dobj <> NIL then begin
  89.             ArgPtr := dobj^.do_ToolTypes;
  90.             With Args do begin
  91.                 arg_LeftEdge   := GetArgInt(ArgPtr,    'LEFTEDGE', arg_LeftEdge);
  92.                 arg_TopEdge    := GetArgInt(ArgPtr,    'TOPEDGE', arg_TopEdge);
  93.                 arg_Icon       := GetArgString(ArgPtr, 'ICON', arg_Icon);
  94.                 arg_Name       := GetArgString(ArgPtr, 'NAME', arg_Name);
  95.                 arg_RexxPort   := GetArgString(ArgPtr, 'REXXPORT', arg_RexxPort);
  96.                 arg_RexxCmd    := GetArgString(ArgPtr, 'REXXCMD', arg_RexxCmd);
  97.                 arg_CXPri      := GetArgInt(ArgPtr,    'CX_PRIORITY', arg_CXPri);
  98.             End;
  99.             FreeDiskObject(dobj);
  100.         end;
  101.     end;
  102.     With Args do begin
  103.         If arg_LeftEdge < 1 then
  104.             arg_LeftEdge := NO_ICON_POSITION;
  105.         If arg_TopEdge < 1 then
  106.             arg_TopEdge  := NO_ICON_POSITION;
  107.     End;
  108.     FreeRemember(@RemKey, True);    
  109. end;
  110.  
  111. (***************************************************************************)
  112. Function Open_Libraries : Boolean;
  113.  
  114.  
  115. Begin
  116.     IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library',37));
  117.     IconBase := OpenLibrary('icon.library',37);
  118.     WorkbenchBase := OpenLibrary('workbench.library',37);
  119.     CxBase := OpenLibrary('commodities.library',37);
  120.     RexxSysBase := pRxsLib(OpenLibrary('rexxsyslib.library',0));
  121.     If (IntuitionBase <> NIL) and (IconBase <> NIL) and 
  122.        (WorkbenchBase <> NIL) and (CxBase <> NIL) then
  123.         Open_Libraries := True
  124.     Else
  125.         Open_Libraries := False;
  126. End;
  127.  
  128.  
  129. (***************************************************************************)
  130. Procedure Close_Libraries;
  131.  
  132. Begin
  133.     CloseLibrary(pLibrary(RexxSysBase));
  134.     CloseLibrary(pLibrary(CxBase));
  135.     CloseLibrary(pLibrary(WorkbenchBase));
  136.     CloseLibrary(pLibrary(IconBase));
  137.     CloseLibrary(pLibrary(IntuitionBase));
  138. End;
  139.  
  140.  
  141. (***************************************************************************)
  142. Procedure Delete_File(filename, infotoken : STRPTR);
  143.     
  144. Var
  145.     e,
  146.     ret   : LONG;
  147.     ok, 
  148.     Ok2   : Boolean;
  149.     fn,
  150.     title,
  151.     btext,
  152.     gtext : String;
  153.     l     : BPTR;
  154.     ez    : pEasyStruct;
  155.     a     : Array[0..1] of STRPTR;
  156.     
  157. begin
  158.     e := SetIOErr(0);
  159.     If MatchPatternNoCase(infotoken, filename) then begin
  160.         { info file }
  161.         fn := PtrToPas(filename);
  162.         Delete(fn, Length(fn)-4, 5);
  163.         fn := fn + #0;
  164.         filename := @fn[1];
  165.         { does the icon have a matching file, if so forget }
  166.         l := Lock(filename, ACCESS_READ);
  167.         If l <> NULL then begin
  168.             { has file }
  169.             Ok := True;
  170.         End else begin
  171.             { lone icon }
  172.             Ok := DeleteDiskObject(filename);
  173.         End;
  174.         UnLock(l);
  175.     End else begin    
  176.         l := Lock(filename, ACCESS_READ);
  177.         If l <> NULL then Begin
  178.             UnLock(l);
  179.             Ok := DeleteFile(filename);
  180.         End else
  181.             Ok := True;
  182.         If Ok then
  183.             Ok2 := DeleteDiskObject(filename);
  184.     End;
  185.     If NOT Ok then begin
  186.         e := IoErr;
  187.         Case e of
  188.             ERROR_DIR_NOT_FOUND,
  189.             ERROR_OBJECT_NOT_FOUND : ;
  190.             ERROR_DELETE_PROTECTED : Begin
  191.                 ez := AllocVec(Sizeof(tEasyStruct), MEMF_CLEAR);
  192.                 If ez <> NIL then Begin
  193.                     title := 'Rubbish Dump'#0;
  194.                     btext := '"%s"'#10 +
  195.                              'Is protected from deletion'#0;
  196.                     gtext := 'Delete|Don''t Delete'#0;
  197.                     With ez^ do Begin
  198.                         es_StructSize   := Sizeof(tEasyStruct);
  199.                         es_Flags        := 0;
  200.                         es_Title        := @title[1];
  201.                         es_TextFormat   := @btext[1];
  202.                         es_GadgetFormat := @gtext[1];
  203.                     End;
  204.                     a[0] := filename;
  205.                     ret := EasyRequestArgs(NIL, ez, NIL, @a);
  206.                     If ret = 1 then begin
  207.                         Ok := SetProtection(filename, 0);
  208.                         fn := PtrToPas(filename) + '.info'#0;
  209.                         Ok := SetProtection(@fn[1], 0);
  210.                         Ok := DeleteFile(filename);
  211.                         Ok := DeleteDiskObject(filename);
  212.                     End;
  213.                     FreeVec(ez);
  214.                 End;
  215.             End;
  216.             Else Begin
  217.                 ez := AllocVec(Sizeof(tEasyStruct), MEMF_CLEAR);
  218.                 If ez <> NIL then Begin
  219.                     title := 'Rubbish Dump'#0;
  220.                     btext := 'Can''t delete "%s"'#10 +
  221.                              '%s'#0;
  222.                     gtext := 'Ok'#0;
  223.                     With ez^ do Begin
  224.                         es_StructSize   := Sizeof(tEasyStruct);
  225.                         es_Flags        := 0;
  226.                         es_Title        := @title[1];
  227.                         es_TextFormat   := @btext[1];
  228.                         es_GadgetFormat := @gtext[1];
  229.                     End;
  230.                     ret := Fault(e, NIL, @fn, Sizeof(fn));
  231.                     a[0] := filename;
  232.                     a[1] := @fn;
  233.                     ret := EasyRequestArgs(NIL, ez, NIL, @a);
  234.                     FreeVec(ez);
  235.                 End;
  236.             End;
  237.         End;
  238.     End;
  239. End;
  240.  
  241.  
  242. (***************************************************************************)
  243. Procedure Delete_Dir(l : BPTR; infotoken : STRPTR);
  244. VAR
  245.     oldcd, 
  246.     l2      : BPTR;
  247.     fib     : pFileInfoBlock;
  248.     OK, ok2 : Boolean;
  249.     s       : String[250];
  250.     
  251. begin
  252.     oldcd := CurrentDir(l);
  253.     fib := AllocDosObject(DOS_FIB, NIL);
  254.     if fib <> NIL then begin
  255.         OK := Examine(l, fib);
  256.         OK := ExNext(l, fib);
  257.         While OK do begin            
  258.             if fib^.fib_DirEntryType > 0 then begin
  259.                 l2 := Lock(@fib^.fib_FileName, ACCESS_READ);
  260.                 Delete_Dir(l2, infotoken);
  261.                 ok2 := NameFromLock(l2, @s, Sizeof(s));
  262.                 UnLock(l2);
  263.                 If ok2 then
  264.                     Delete_File(@s, infotoken);
  265.             End;
  266.             if fib^.fib_DirEntryType < 0 then
  267.                 Delete_File(@fib^.fib_FileName, infotoken);
  268.             OK := ExNext(l, fib);
  269.         end;
  270.         FreeDosObject(DOS_FIB, fib);
  271.     End;
  272.     oldcd := CurrentDir(oldcd);
  273. End;
  274.  
  275.  
  276. (***************************************************************************)
  277. Procedure HandleAppIcon(VAR aih       : tAIHandle; 
  278.                         VAR V         : tProgVars;
  279.                             enabled   : Boolean;
  280.                             infotoken : STRPTR);
  281. Type
  282.     pLNode = ^tLNode;
  283.     tLNode = Record
  284.         ln_Succ : pLNode;
  285.         ln_Pred : pLNode;
  286.         ln_Lock : BPTR;
  287.         ln_Name : STRPTR;
  288.     End;
  289.  
  290. Var
  291.     n     : Integer;
  292.     WBArg : pWBArg;
  293.     ap    : pAnchorPath;
  294.     err   : LONG;
  295.     l     : BPTR;
  296.     am    : pAppMessage;
  297.     ok    : Boolean;
  298.     s     : String;
  299.     node  : pLNode;
  300.     list  : tList;
  301.     lrk   : pRemember;
  302.     
  303. Begin
  304.     am := pAppMessage(GetMsg(aih.ai_MsgPort));
  305.     While am <> NIL do begin
  306.         If Enabled then begin
  307.             If NOT((am^.am_NumArgs = 0) or (am^.am_ArgList = NIL)) then begin
  308.                 lrk := NIL;
  309.                 NewList(@list);
  310.                 { copy the args, so the locks get freed }
  311.                 WBArg := am^.am_ArgList;
  312.                 For n := 1 to am^.am_NumArgs do begin
  313.                     node := AllocRemember(@lrk, SizeOf(tLNode), MEMF_CLEAR);
  314.                     If node <> NIL then begin
  315.                         node^.ln_Name := CSCPAR(@lrk, PtrToPas(STRPTR(WBArg^.wa_Name)));
  316.                         node^.ln_Lock := DupLock(WBArg^.wa_Lock);
  317.                         AddTail(@list, pNode(node));
  318.                     End;
  319.                     WBArg := Pointer(Long(WBArg) + sizeof(tWBArg));
  320.                 End;    
  321.                 
  322.                 ReplyMsg(pMessage(am));
  323.                 am := pAppMessage(GetMsg(aih.ai_MsgPort));
  324.                 
  325.                 { delete the objects }
  326.                 node := pLNode(list.lh_Head);
  327.                 While node^.ln_Succ <> NIL do begin
  328.                     If PtrToPas(node^.ln_Name) = '' then begin
  329.                         { dir }
  330.                         Delete_Dir(Node^.ln_Lock,infotoken);
  331.                         ok := NameFromLock(Node^.ln_Lock, @s, Sizeof(s));
  332.                         UnLock(Node^.ln_Lock);
  333.                         If ok then
  334.                             Delete_File(@s, infotoken);
  335.                     End else begin
  336.                         { file }
  337.                         l := CurrentDir(Node^.ln_Lock);
  338.                         Delete_File(Node^.ln_Name, infotoken);
  339.                         l := CurrentDir(l);
  340.                         UnLock(Node^.ln_Lock);
  341.                     End;
  342.                     node := node^.ln_Succ;
  343.                 End;                
  344.             
  345.                 FreeRemember(@lrk, True);
  346.                 SendARexxCommand(V.arg_RexxCmd, V.arg_RexxPort);
  347.             End else begin
  348.                 ReplyMsg(pMessage(am));
  349.                 am := pAppMessage(GetMsg(aih.ai_MsgPort));
  350.             End;
  351.         End else begin
  352.             ReplyMsg(pMessage(am));
  353.             am := pAppMessage(GetMsg(aih.ai_MsgPort));
  354.         End;
  355.     End;
  356. End;
  357.  
  358. (***************************************************************************)
  359. Procedure HandleMsgs(VAR cxh : tCxHandle;
  360.                      VAR aih : tAIHandle;
  361.                      VAR V   : tProgVars);
  362.                      
  363. Var
  364.     CxMask, AIMask,
  365.     sigre,
  366.     cxtype, cxid : LONG;
  367.     am : pAppMessage;
  368.     cxm : pCxMsg;
  369.     ExitFlag,
  370.     Enabled : Boolean;
  371.     InfoToken : String;
  372.  
  373. Const
  374.     InfoS : String[8] = '#?.info'#0;
  375.     
  376. Begin
  377.     If ParsePatternNoCase(@infos[1], @infotoken, SizeOf(infotoken)) <> 0 Then ;
  378.     CxMask := (1 shl cxh.cx_MsgPort^.MP_SIGBIT);
  379.     AIMask := (1 shl aih.ai_MsgPort^.MP_SIGBIT);
  380.     Enabled := True;
  381.     ExitFlag := False;
  382.     While Not ExitFlag do Begin
  383.         sigre := Wait(CxMask|AIMask|SIGBREAKF_CTRL_C);
  384.         
  385.         if ((sigre and SIGBREAKF_CTRL_C)=SIGBREAKF_CTRL_C) then
  386.             ExitFlag := True;
  387.             
  388.         if ((sigre and AIMask)=AIMask) then begin
  389.             HandleAppIcon(aih, V, enabled, @infotoken);
  390.         End; {aimask}
  391.         
  392.         if ((sigre and CxMask)=CxMask) then begin
  393.             cxm := pCxMsg(GetMsg(cxh.cx_MsgPort));
  394.             While cxm <> NIL do begin
  395.                 cxtype := CxMsgType(CxM);
  396.                 cxid := CxMsgID(CxM);
  397.                 ReplyMsg(pMessage(cxm));
  398.                 Case cxtype of
  399.                     CXM_COMMAND : begin
  400.                         case cxid of
  401.                             CXCMD_DISABLE   : Enabled := False;
  402.                             CXCMD_ENABLE    : Enabled := True;
  403.                             CXCMD_KILL      : ExitFlag := True;
  404.                             CXCMD_UNIQUE    : ExitFlag := True;
  405.                         end; {case cxid}
  406.                     end; {cxm_command}
  407.                 End; {case cxtype}
  408.                 cxm := pCxMsg(GetMsg(cxh.cx_MsgPort));
  409.             End;
  410.         End; {CxMask}
  411.             
  412.     End; {while not exitflag}
  413. End;
  414.  
  415.  
  416. (***************************************************************************)
  417. Procedure Main;
  418.  
  419. Var
  420.     V   : tProgVars;
  421.     cxh : tCxHandle;
  422.     aih : tAIHandle;
  423.  
  424. Begin
  425.     If pLibrary(SysBase)^.lib_Version < 37 then Halt;
  426.     
  427.     If Open_Libraries then begin
  428.         GetToolTypes(V);
  429.         If InitCx(cxh, cxname, cxtitle, cxdesc, 0, NBU_UNIQUE|NBU_NOTIFY, V.arg_CXPri) then begin
  430.             If AddAIcon(aih, V.arg_Icon, V.arg_Name, V.arg_LeftEdge, 
  431.                         V.arg_TopEdge, 0, 0, True) Then begin
  432.                 HandleMsgs(cxh, aih, V);
  433.                 RemoveAIcon(aih);
  434.             End;
  435.             RemoveCx(cxh);
  436.         End;
  437.         Close_Libraries;
  438.     End;
  439. End;
  440.  
  441.  
  442. (***************************************************************************)
  443. Begin Main End.